Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/winview/winview.frm

Visual Basic Form | 1999-09-15 | 20.9 KB | 585 lines

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form Winview
   Caption         =   "WinView"
   ClientHeight    =   3555
   ClientLeft      =   1335
   ClientTop       =   1635
   ClientWidth     =   11280
   BeginProperty Font
      Name            =   "MS Sans Serif"
      Size            =   8.25
      Charset         =   0
      Weight          =   700
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000008&
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   237
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   752
   Begin VB.PictureBox picCatch
      Height          =   375
      Left            =   6240
      ScaleHeight     =   315
      ScaleWidth      =   615
      TabIndex        =   8
      Top             =   3000
      Width           =   675
   End
   Begin VB.CommandButton cmdPosition
      Caption         =   "Position"
      Height          =   435
      Left            =   240
      TabIndex        =   2
      Top             =   2460
      Width           =   975
   End
   Begin VB.CommandButton cmdSize
      Caption         =   "Size"
      Height          =   435
      Left            =   1320
      TabIndex        =   3
      Top             =   2460
      Width           =   975
   End
   Begin VB.CommandButton cmdClassInfo
      Caption         =   "ClassInfo"
      Height          =   435
      Left            =   2400
      TabIndex        =   4
      Top             =   2460
      Width           =   975
   End
   Begin VB.CommandButton cmdWinStyles
      Caption         =   "WinStyles"
      Height          =   435
      Left            =   3480
      TabIndex        =   5
      Top             =   2460
      Width           =   1035
   End
   Begin VB.CommandButton cmdFlash
      Caption         =   "Flash"
      Height          =   435
      Left            =   4620
      TabIndex        =   6
      Top             =   2460
      Width           =   975
   End
   Begin VB.CommandButton cmdCtlName
      Caption         =   "CtlName"
      Height          =   435
      Left            =   240
      TabIndex        =   7
      Top             =   3000
      Width           =   975
   End
   Begin VB.CommandButton cmdParent
      Caption         =   "Parent"
      Height          =   435
      Left            =   1320
      TabIndex        =   1
      Top             =   3000
      Width           =   975
   End
   Begin ComctlLib.ListView lvwWindows
      Height          =   2010
      Left            =   240
      TabIndex        =   10
      Top             =   360
      Width           =   10770
      _ExtentX        =   18997
      _ExtentY        =   3545
      View            =   3
      LabelEdit       =   1
      Sorted          =   -1  'True
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   327682
      ForeColor       =   -2147483640
      BackColor       =   16777215
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   4
      BeginProperty ColumnHeader(1) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
         Key             =   ""
         Object.Tag             =   ""
         Text            =   "hWnd"
         Object.Width           =   2999
      EndProperty
      BeginProperty ColumnHeader(2) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
         SubItemIndex    =   1
         Key             =   ""
         Object.Tag             =   ""
         Text            =   "ExePath"
         Object.Width           =   1587
      EndProperty
      BeginProperty ColumnHeader(3) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
         SubItemIndex    =   2
         Key             =   ""
         Object.Tag             =   ""
         Text            =   "Class"
         Object.Width           =   3175
      EndProperty
      BeginProperty ColumnHeader(4) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
         SubItemIndex    =   3
         Key             =   ""
         Object.Tag             =   ""
         Text            =   "WindowText"
         Object.Width           =   1587
      EndProperty
   End
   Begin VB.Label lblHere
      Alignment       =   1  'Right Justify
      Caption         =   "Click Here For point mode 2 -->"
      Height          =   255
      Left            =   3420
      TabIndex        =   9
      Top             =   3120
      Width           =   2835
   End
   Begin VB.Label lblMsg
      Height          =   195
      Left            =   240
      TabIndex        =   0
      Top             =   120
      Width           =   5415
   End
   Begin VB.Menu mnuLoadList
      Caption         =   "LoadList"
      Begin VB.Menu mnuTopLevel
         Caption         =   "&TopLevel"
         Shortcut        =   ^T
      End
      Begin VB.Menu mnuChildren
         Caption         =   "&Children"
         Shortcut        =   ^C
      End
      Begin VB.Menu mnuOwned
         Caption         =   "&Owned"
         Shortcut        =   ^O
      End
      Begin VB.Menu MenuPointed
         Caption         =   "&Pointed"
         Shortcut        =   ^P
      End
      Begin VB.Menu mnuClear
         Caption         =   "C&lear"
      End
   End
Attribute VB_Name = "Winview"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Enum enPointMode
    enPointModeOff = 0
    enPointModeMenu = 1
    enPointModePic = 2
End Enum
Private genPointMode As enPointMode
Private Sub Form_Load()
    SetListviewStyle lvwWindows.hWnd, LVS_EX_FULLROWSELECT, True
End Sub
' If point mode was started via menu, record the current window
' in the listbox
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If genPointMode <> enPointModeMenu Then Exit Sub
    AddToList lblMsg.Caption
    genPointMode = enPointModeOff
    lblMsg.Caption = ""
    ' If capture is still held, release it
    If GetCapture() = Me.hWnd Then ReleaseCapture
End Sub
' If point mode was started via PictureBox, record the current window
' in the listbox
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If genPointMode <> enPointModePic Then Exit Sub
    AddToList lblMsg.Caption
    genPointMode = enPointModeOff
    lblMsg.Caption = ""
    ' If capture is still held, release it
    If GetCapture() = Me.hWnd Then ReleaseCapture
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim tPT As POINTAPI
    Dim hWndFound As Long
    ' Only record window if we're in point mode
    If genPointMode = enPointModeOff Then Exit Sub
    ' convert clienet-coordinates to logical-coordinates
    tPT.x = x
    tPT.y = y
    ClientToScreen Me.hWnd, tPT
    ' get Window-Handle and Description
    hWndFound = WindowFromPoint(tPT.x, tPT.y)
    lblMsg.Caption = GetWindowDesc(hWndFound)
End Sub
'------------------------------------------------------------------------------
' Show the position of the selected window
Private Sub cmdPosition_Click()
    Dim tRECTWnd As RECT
    Dim hWnd As Long
    Dim sOut As String
    Dim sTitle As String
    If lvwWindows.SelectedItem Is Nothing Then
        MsgBox "No windows selected", 0, "Error"
        Exit Sub
    End If
    sTitle = lvwWindows.SelectedItem
    hWnd = GetHWnd(sTitle)
    ' Get the rectangle describing the window
    GetWindowRect hWnd, tRECTWnd
    If IsIconic(hWnd) Then sOut = "Is Iconic" & vbCrLf
    If IsZoomed(hWnd) Then sOut = sOut & "Is Zoomed" & vbCrLf
    If IsWindowEnabled(hWnd) Then
        sOut = sOut & "Is Enabled" & vbCrLf
    Else
        sOut = sOut & "Is Disabled" & vbCrLf
    End If
    If IsWindowVisible(hWnd) Then
        sOut = sOut & "Is Visible" & vbCrLf
    Else
        sOut = sOut & "Is NOT Visible" & vbCrLf
    End If
    With tRECTWnd
        sOut = sOut & "Rect: " & CStr(.Left) & ", "
        sOut = sOut & CStr(.Top) & ", "
        sOut = sOut & CStr(.Right) & ", "
        sOut = sOut & CStr(.Bottom)
    End With
    MsgBox sOut, 0, sTitle
End Sub
' Show the size of the selected window
Private Sub cmdSize_Click()
    Dim tRECTWndClient As RECT
    Dim hWnd As Long
    Dim sOut As String
    Dim sTitle As String
    If lvwWindows.SelectedItem Is Nothing Then
        MsgBox "No windows selected", 0, "Error"
        Exit Sub
    End If
    sTitle = lvwWindows.SelectedItem
    hWnd = GetHWnd(sTitle)
    ' Get the rectangle describing the window
    GetClientRect hWnd, tRECTWndClient
    sOut = "Horiz Pixels: " & CStr(tRECTWndClient.Right) & vbCrLf
    sOut = sOut & "Vert Pixels: " & CStr(tRECTWndClient.Bottom)
    MsgBox sOut, 0, sTitle
End Sub
' Show class styles for the selected window
Private Sub cmdClassInfo_Click()
    Dim lClsExtra As Long
    Dim lWndExtra As Long
    Dim lStyle As Long
    Dim hWnd As Long
    Dim sOut As String
    Dim sTitle As String
    If lvwWindows.SelectedItem Is Nothing Then
        MsgBox "No windows selected", 0, "Error"
        Exit Sub
    End If
    sTitle = lvwWindows.SelectedItem
    hWnd = GetHWnd(sTitle)
    ' Get the class info
    ' These all used to be GetClassWord and GCW_ constants
    lClsExtra = GetClassLong(hWnd, GCL_CBCLSEXTRA)
    lWndExtra = GetClassLong(hWnd, GCL_CBWNDEXTRA)
    lStyle = GetClassLong(hWnd, GCL_STYLE)
    sOut = "Class & Word Extra = " & CStr(lClsExtra) & ", " & _
                CStr(lWndExtra) & vbCrLf

    If lStyle And CS_BYTEALIGNCLIENT Then sOut = sOut & "CS_BYTEALIGNCLIENT" & vbCrLf
    If lStyle And CS_BYTEALIGNWINDOW Then sOut = sOut & "CS_BYTEALIGNWINDOW" & vbCrLf
    If lStyle And CS_CLASSDC Then sOut = sOut & "CS_CLASSDC" & vbCrLf
    If lStyle And CS_DBLCLKS Then sOut = sOut & "CS_DBLCLKS" & vbCrLf
    ' Was CS_GLOBALCLASS (has same value)
    If lStyle And CS_PUBLICCLASS Then sOut = sOut & "CS_GLOBALCLASS" & vbCrLf
    If lStyle And CS_HREDRAW Then sOut = sOut & "CS_HREDRAW" & vbCrLf
    If lStyle And CS_NOCLOSE Then sOut = sOut & "CS_NOCLOSE" & vbCrLf
    If lStyle And CS_OWNDC Then sOut = sOut & "CS_OWNDC" & vbCrLf
    If lStyle And CS_PARENTDC Then sOut = sOut & "CS_PARENTDC" & vbCrLf
    If lStyle And CS_SAVEBITS Then sOut = sOut & "CS_SAVEBITS" & vbCrLf
    If lStyle And CS_VREDRAW Then sOut = sOut & "CS_VREDRAW" & vbCrLf
    If lStyle And CS_NOKEYCVT Then sOut = sOut & "CS_NOKEYCVT" & vbCrLf
    If lStyle And CS_KEYCVTWINDOW Then sOut = sOut & "CS_KEYCVTWINDOW" & vbCrLf
    MsgBox sOut, 0, sTitle
End Sub
' Show window styles for the selected window
Private Sub cmdWinStyles_Click()
    Dim lStyle As Long
    Dim hWnd As Long
    Dim sOut As String
    Dim sTitle As String
    If lvwWindows.SelectedItem Is Nothing Then
        MsgBox "No windows selected", 0, "Error"
        Exit Sub
    End If
    sTitle = lvwWindows.SelectedItem
    hWnd = GetHWnd(sTitle)
    ' Get the class info
    lStyle = GetWindowLong(hWnd, GWL_STYLE)
    If lStyle And WS_BORDER Then sOut = sOut & "WS_BORDER" & vbCrLf
    If lStyle And WS_CAPTION Then sOut = sOut & "WS_CAPTION" & vbCrLf
    If lStyle And WS_CHILD Then sOut = sOut & "WS_CHILD" & vbCrLf
    If lStyle And WS_CLIPCHILDREN Then sOut = sOut & "WS_CLIPCHILDREN" & vbCrLf
    If lStyle And WS_CLIPSIBLINGS Then sOut = sOut & "WS_CLIPSIBLINGS" & vbCrLf
    If lStyle And WS_DISABLED Then sOut = sOut & "WS_DISABLED" & vbCrLf
    If lStyle And WS_DLGFRAME Then sOut = sOut & "WS_DLGFRAME" & vbCrLf
    If lStyle And WS_GROUP Then sOut = sOut & "WS_GROUP" & vbCrLf
    If lStyle And WS_HSCROLL Then sOut = sOut & "WS_HSCROLL" & vbCrLf
    If lStyle And WS_MAXIMIZE Then sOut = sOut & "WS_MAXIMIZE" & vbCrLf
    If lStyle And WS_MAXIMIZEBOX Then sOut = sOut & "WS_MAXIMIZEBOX" & vbCrLf
    If lStyle And WS_MINIMIZE Then sOut = sOut & "WS_MINIMIZE" & vbCrLf
    If lStyle And WS_MINIMIZEBOX Then sOut = sOut & "WS_MINIMIZEBOX" & vbCrLf
    If lStyle And WS_POPUP Then sOut = sOut & "WS_POPUP" & vbCrLf
    If lStyle And WS_SYSMENU Then sOut = sOut & "WS_SYSMENU" & vbCrLf
    If lStyle And WS_TABSTOP Then sOut = sOut & "WS_TABSTOP" & vbCrLf
    If lStyle And WS_THICKFRAME Then sOut = sOut & "WS_THICKFRAME" & vbCrLf
    If lStyle And WS_VISIBLE Then sOut = sOut & "WS_VISIBLE" & vbCrLf
    If lStyle And WS_VSCROLL Then sOut = sOut & "WS_VSCROLL" & vbCrLf
    ' Note: We could tap the lStyle variable for class
    ' styles as well (especially since it is easy to
    ' determine the class for a window), but that is
    ' beyond the scope of this sample program.
    MsgBox sOut, 0, sTitle
End Sub
' Flashes the caption of the selected window. This feature
' is typically attached to a timer when the code needs to
' "flash" a window caption to attract the users attention.
' Try clicking this button several times quickly for a
' visible window that has a caption to see the effect
Private Sub cmdFlash_Click()
    Dim hWnd As Long
    Dim sTitle As String
    Dim lRet As Long
    If lvwWindows.SelectedItem Is Nothing Then
        MsgBox "No windows selected", 0, "Error"
        Exit Sub
    End If
    sTitle = lvwWindows.SelectedItem
    hWnd = GetHWnd(sTitle)
    lRet = FlashWindow(hWnd, -1)
End Sub
' Obtains the control name or form name of a Visual
' Basic form or control given the window handle.
' Non VB windows will have no form or control name
Private Sub cmdCtlName_Click()
    Dim sTitle As String
    Dim sOut As String
    Dim hWnd As Long
    If lvwWindows.SelectedItem Is Nothing Then
        MsgBox "No windows selected", 0, "Error"
        Exit Sub
    End If
    sTitle = lvwWindows.SelectedItem
    hWnd = GetHWnd(sTitle)
    sOut = GetControlNameFromWindow(hWnd)
    If Len(sOut) = 0 Then
        MsgBox "Not a VB Form or Control", 0, sTitle
    Else
        MsgBox "CtlName or FormName = " & sOut, 0, sTitle
    End If
End Sub
Private Sub cmdParent_Click()
    Dim hWnd As Long
    Dim sTitle As String
    Dim hParent As Long
    Dim sDescr As String
    If lvwWindows.SelectedItem Is Nothing Then
        MsgBox "No windows selected", 0, "Error"
        Exit Sub
    End If
    sTitle = lvwWindows.SelectedItem
    hWnd = GetHWnd(sTitle)
    hParent = GetParent(hWnd)
    If hParent = 0 Then
        MsgBox "Window has no parent", 0, "Window &H" & Hex$(hWnd)
        Exit Sub
    End If
    sDescr = GetWindowDesc(hParent)
    MsgBox sDescr, 0, "Parent of &H" & Hex$(hWnd) & " is"
End Sub
Private Sub picCatch_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim lRet As Long
    ' Let system know that we're in point mode
    genPointMode = enPointModePic
    lRet = SetCapture(Me.hWnd)
    ' Initialize the label
    lblMsg.Caption = GetWindowDesc(picCatch.hWnd)
End Sub
'   Loads the listbox with a list of all top level
'   windows.
Private Sub mnuTopLevel_Click()
    Dim hWnd As Long
    ' Clear the listbox
    lvwWindows.ListItems.Clear
    ' The desktop is the highest window
    hWnd = GetDesktopWindow()
    ' It's first child is the 1st top level window
    hWnd = GetWindow(hWnd, GW_CHILD)
    ' Now load all top level windows
    Do
        AddToList GetWindowDesc(hWnd)
        hWnd = GetWindow(hWnd, GW_HWNDNEXT)
    Loop While hWnd <> 0
    lblMsg.Caption = "Top level windows"
    Set lvwWindows.SelectedItem = lvwWindows.ListItems(1)
End Sub
Private Sub mnuChildren_Click()
    Dim hWnd As Long
    Dim sTitle As String
    ' Is there a window selected?
    If lvwWindows.SelectedItem Is Nothing Then
        MsgBox "No windows selected", 0, "Error"
        Exit Sub
    End If
    sTitle = lvwWindows.SelectedItem
    hWnd = GetHWnd(sTitle)
    ' It's first child is the specified window
    hWnd = GetWindow(hWnd, GW_CHILD)
    If hWnd = 0 Then
        MsgBox "No children found for this window", 0, "Error"
        Exit Sub
    End If
    ' Clear the listbox
    lvwWindows.ListItems.Clear
    ' Now load all the child windows
    Do
        AddToList GetWindowDesc(hWnd)
        hWnd = GetWindow(hWnd, GW_HWNDNEXT)
    Loop While hWnd <> 0
    Set lvwWindows.SelectedItem = lvwWindows.ListItems(1)
    lblMsg.Caption = "Children of: " & sTitle
End Sub
'   Show owned windows of the currently selected window
Private Sub mnuOwned_Click()
    Dim hWnd As Long
    Dim sTitle As String
    Dim lRet As Long
    ' Is there a window selected?
    If lvwWindows.SelectedItem Is Nothing Then
        MsgBox "No windows selected", 0, "Error"
        Exit Sub
    End If
    sTitle = lvwWindows.SelectedItem
    hWnd = GetHWnd(sTitle)
    ' Clear the listbox
    lvwWindows.ListItems.Clear
    ' This uses VB5's support for callbacks to a callback
    ' address for EnumWindows.
    ' This will trigger the Callback1_EnumWindows function
    ' for each top level window.  This technique could
    ' also have been used in place of the GetWindow loop
    ' in the mnuTopLevel_Click event.
    lRet = EnumWindows(AddressOf Callback1_EnumWindows, hWnd)
    If lvwWindows.ListItems.Count = 0 Then
        MsgBox "No owned windows found for this window", 0, "Error"
        lblMsg.Caption = ""
        Exit Sub
    End If
    lblMsg.Caption = "Owned windows of: " & sTitle
End Sub
Private Sub mnuPointed_Click()
    Dim lRet As Long
    ' Let system know that we're in point mode
    genPointMode = enPointModeMenu
    lRet = SetCapture(Me.hWnd)
End Sub
'   Just clear the listbox
Private Sub mnuClear_Click()
    lvwWindows.ListItems.Clear
End Sub
Private Function GetHWnd(ByVal vsTitle As String) As Long
    Dim lPos As Long
    lPos = InStr(vsTitle, vbTab)
    If lPos > 0 Then
        GetHWnd = Val(Left$(vsTitle, lPos - 1))
    Else
        GetHWnd = Val(vsTitle)
    End If
End Function
' Builds a string describing the window in format
' handle, source application, class
' seperated by tabs
' This function needs to be public since it is called by the
' callback function in the Winview1 module
Public Function GetWindowDesc(hWnd As Long) As String
    Dim sDesc As String
    Dim sTemp As String
    Dim hInst As Long
    Dim lRet As Long
    Dim hWndProcessID As Long
    ' Include the windows handle first
    sDesc = "&H" & Hex$(hWnd) & vbTab
    ' Get name of source app
    sTemp = String$(256, 0) ' Predefine string length
    lRet = GetWindowThreadProcessId(hWnd, hWndProcessID)
    If hWndProcessID = GetCurrentProcessId() Then
        ' Get instance for window
        hInst = GetWindowLong(hWnd, GWL_HINSTANCE)
        ' Get the module filename
        lRet = GetModuleFileName(hInst, sTemp, 255)
        sTemp = LPSTRToStr(sTemp)

        sTemp = GetBaseName(sTemp)
    Else
        If SupportsToolHelp() Then
            sTemp = GetBaseName(GetWin95ModuleName(hWndProcessID))
        ElseIf IsNT() And SupportsPSAPI() Then
            sTemp = GetBaseName(GetNTModuleName(hWndProcessID))
        End If
    End If
    ' And add it to the description
    sDesc = sDesc & sTemp & vbTab
    ' Finally, add the class name
    sTemp = String$(256, 0) ' Initialize space again
    lRet = GetClassName(hWnd, sTemp, 255)
    sTemp = LPSTRToStr(sTemp)
    sDesc = sDesc & sTemp & vbTab
    sTemp = String$(256, 0) ' Predefine string length
    lRet = GetWindowText(hWnd, sTemp, 255)
    sTemp = LPSTRToStr(sTemp)
    sDesc = sDesc & sTemp
    ' And return the description
    GetWindowDesc = sDesc
End Function
Public Function GetControlNameFromWindow(ByVal hWnd As Long)
    Dim nForm As Integer
    Dim nCtl As Integer
    For nForm = 0 To Forms.Count - 1
        If Forms(nForm).hWnd = hWnd Then
            GetControlNameFromWindow = Forms(nForm).Name
            Exit Function
        End If

        For nCtl = 0 To Forms(nCtl).Controls.Count - 1
            On Error Resume Next
            If Forms(nForm).Controls(nCtl).hWnd = hWnd Then
                If Err.Number = 0 Then
                    GetControlNameFromWindow = Forms(nForm).Controls(nCtl).Name
                End If
                Exit Function
            End If
        Next nCtl
    Next nForm
End Function
' If sPath is a path, this function retrieves the
' basename, or filename sans path
' sPath MUST be a valid filename
Private Function GetBaseName(ByVal vsPath As String) As String
    Do While InStr(vsPath, "\") <> 0
        vsPath = Mid$(vsPath, InStr(vsPath, "\") + 1)
    Loop
    If InStr(vsPath, ":") <> 0 Then
        vsPath = Mid$(vsPath, InStr(vsPath, ":") + 1)
    End If
    GetBaseName = vsPath
End Function